home *** CD-ROM | disk | FTP | other *** search
/ PC-X 1997 October / pcx14_9710.iso / swag / delphi.swg / 0204_Extract WIN95 animated Cursors.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-11-29  |  10.7 KB  |  349 lines
  1. {
  2.                   =======================================
  3.  
  4.                        ANI2ICO V1.0 (c) AVC Software
  5.                                 Cardware
  6.  
  7.                    ANI2ICO extract all pictures from an
  8.                    ANI file (animated cursor).
  9.  
  10.                    This is a DOS based program and help
  11.                    can be obtain when you launch the
  12.                    program without argument.
  13.  
  14.                            AVONTURE Christophe
  15.                       Boulevard Edmond Macthens 157
  16.                                Boite 53
  17.                            B-1080 Bruxelles
  18.                                BELGIQUE
  19.  
  20.                   =======================================
  21.  
  22.  
  23.    The purpose of this program is to extract all CURSOR in a Windows 95 (c)
  24.    Animated Cursor file (ANI  extension) and save these  cursors for  later
  25.    use in Delphi, or all other Windows program that accept Cursor.
  26.  
  27.    I have use an Hexadecimal viewer program to find the layout of the file:
  28.    don't ask  me about  the  signification of some  block or why  there are
  29.    always 8 bytes between each cursors; and so on.
  30.  
  31.    This program works on  almost file: there are a few  Ani file where this
  32.    program should not work -only for the last cursor-.
  33.  
  34.  
  35.  
  36.  
  37.                ╔════════════════════════════════════════╗
  38.                ║                                        ║░
  39.                ║          AVONTURE CHRISTOPHE           ║░
  40.                ║              AVC SOFTWARE              ║░
  41.                ║     BOULEVARD EDMOND MACHTENS 157/53   ║░
  42.                ║           B-1080 BRUXELLES             ║░
  43.                ║              BELGIQUE                  ║░
  44.                ║                                        ║░
  45.                ╚════════════════════════════════════════╝░
  46.                ░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░
  47.  
  48. }
  49.  
  50. Uses Crt;
  51.  
  52. TYPE
  53.    TAniHeader = Record
  54.       sRiff        : Array [1..4] of Char;
  55.       wFileSize    : LongInt;
  56.       sAconList    : Array [1..8] of Char;
  57.       wTextSize    : LongInt;
  58.       sInfoInam    : Array [1..8] of Char;
  59.       wTitleLength : LongInt;
  60.    End;
  61.  
  62. VAR
  63.    fAni        : FILE;
  64.    Header      : TAniHeader;
  65.    sTitre      : String;
  66.    sIART       : Array[1..4] of Char;
  67.    wCopyLength : LongInt;
  68.    sCopywrigth : String;
  69.    sAnih       : Array[1..4] of Char;
  70.    wSizeAnih   : LongInt;
  71.    sRate       : Array[1..4] of Char;
  72.    wSizeRate   : LongInt;
  73.    sList       : Array[1..4] of Char;
  74.    wSizeList   : LongInt;
  75.    sFramIcon   : Array[1..8] of Char;
  76.    wIconSize   : LongInt;
  77.    sSeq        : Array[1..4] of Char;
  78.    wSizeSeq    : LongInt;
  79.    wHeaderSize : Word;
  80.  
  81.    pTemp       : Pointer;
  82.    pBuf        : Pointer;
  83.    pRate        : Pointer;
  84.    pSeq        : Pointer;
  85.  
  86.    fIco        : File;
  87.    pIco        : Pointer;
  88.    wIco        : Word;
  89.    sIcoName    : String;
  90.  
  91.    I           : Word;
  92.    wTemp       : LongInt;
  93.  
  94.    sTemp       : String;
  95.  
  96. Procedure ClrScrWin (FirstCol, FirstLine, LastCol, LastLine : Byte);
  97. Var I, J : byte;
  98.     S    : String;
  99. Begin
  100.      J := (LastCol - FirstCol) + 1;
  101.  
  102.      FillChar(S[1], J, ' ');
  103.      S[0] := Chr(J);
  104.  
  105.      For i:= FirstLine to LastLine Do
  106.        Begin
  107.           GotoXy (FirstCol, I);
  108.           WriteLn (S);
  109.        End;
  110. End;
  111.  
  112. procedure Process;
  113.  
  114. begin
  115.  
  116.     GetMem (pTemp, 1000);
  117.     GetMem (pBuf,  1000);
  118.     GetMem (pRate, 1000);
  119.     GetMem (pSeq,  1000);
  120.     sSeq := '    ';
  121.  
  122.     Assign (fAni, ParamStr(1));
  123.     filemode := 0;
  124.     reset (fAni,1);
  125.  
  126.     BlockRead (fAni, Header,      SizeOf(Header));
  127.     BlockRead (fAni, pTemp^,      Header.wTitleLength);
  128.  
  129.     FillChar (sTitre, 1, Header.wTitleLength);
  130.     Move (pTemp^, sTitre[1], Header.wTitleLength);
  131.  
  132.     BlockRead (fAni, sIART,       SizeOf(sIart));
  133.     IF sIart = chr(0)+'IAR' THEN
  134.        BEGIN
  135.          BlockRead (fAni, sIart, 1);
  136.          sIart := 'IART';
  137.        END;
  138.     
  139.     BlockRead (fAni, wCopyLength, SizeOf(wCopyLength));
  140.  
  141.     WITH Header DO
  142.        wHeaderSize := SizeOf(sRiff) + SizeOf(wFileSize) + SizeOf(sAconList) +
  143.                       SizeOf(wTextSize) + wTextSize;
  144.  
  145.     BlockRead (fAni, pTemp^,      wHeaderSize-FilePos(fAni));
  146.  
  147.     FillChar (sCopywrigth, 1, wCopyLength);
  148.     Move (pTemp^, sCopywrigth[1], wCopyLength);
  149.  
  150.     BlockRead (fAni, sAnih,       SizeOf(sAnih));
  151.  
  152.     BlockRead (fAni, wSizeAnih,  SizeOf(wSizeAnih));
  153.  
  154.  
  155.     BlockRead (fAni, pBuf^,       wSizeAnih);
  156.     BlockRead (fAni, sRate,       SizeOf(sRate));
  157.  
  158.     IF (sRate = 'LIST') THEN
  159.        BEGIN
  160.           Move (sRate, sList, SizeOf(sList));
  161.           sRate := '    ';
  162.        END
  163.     ELSE
  164.        IF (sRate = 'seq ') THEN
  165.           BEGIN
  166.              Move (sRate, sSeq, SizeOf(sSeq));
  167.              BlockRead (fAni, wSizeSeq,  SizeOf(wSizeSeq));
  168.              BlockRead (fAni, pSeq^,     wSizeSeq);
  169.              BlockRead (fAni, sList,     SizeOf(sList));
  170.              sRate := '    ';
  171.           END
  172.        ELSE
  173.           BEGIN
  174.              BlockRead (fAni, wSizeRate, SizeOf(wSizeRate));
  175.  
  176.              BlockRead (fAni, pRate^,  wSizeRate);
  177.              BlockRead (fAni, sList,       SizeOf(sList));
  178.           END;
  179.  
  180.     IF NOT (sList = 'LIST') THEN
  181.        BEGIN
  182.           Move (sList, sSeq, SizeOf(sSeq));
  183.           BlockRead (fAni, wSizeSeq,  SizeOf(wSizeSeq));
  184.           BlockRead (fAni, pSeq^,     wSizeSeq);
  185.           BlockRead (fAni, sList,     SizeOf(sList));
  186.        END;
  187.  
  188.     BlockRead (fAni, wSizeList,   SizeOf(wSizeList));
  189.     BlockRead (fAni, sFramIcon,   SizeOf(sFramIcon));
  190.     BlockRead (fAni, wIconSize,   SizeOf(wIconSize));
  191.  
  192.     TextAttr := 14;
  193.  
  194.     WriteLn ('');
  195.     WriteLn ('');
  196.     WriteLn ('');
  197.     WriteLn ('■ File : '+ParamStr(1));
  198.     TextAttr := 11;
  199.     WriteLn ('');
  200.     WriteLn ('');
  201.     WriteLn ('  Copywright message     : '+sCopywrigth);
  202.     WriteLn ('');
  203.     WriteLn ('');
  204.     TextAttr := 10;
  205.  
  206.     GetMem (pIco, wIconSize);
  207.  
  208.     WHILE NOT (Eof(fAni)) DO
  209.        BEGIN
  210.  
  211.           sIcoName := '';
  212.           Str (wIco,sIcoName);
  213.  
  214.           IF wIco < 10 THEN
  215.              sIcoName := 'ANI_000' + sIcoName + '.CUR'
  216.           ELSE IF wIco < 100 THEN
  217.              sIcoName := 'ANI_00' + sIcoName + '.CUR'
  218.           ELSE IF wIco < 1000 THEN
  219.              sIcoName := 'ANI_0' + sIcoName + '.CUR'
  220.           ELSE
  221.              sIcoName := 'ANI_' + sIcoName + '.CUR';
  222.  
  223.           Assign (fIco, sIcoName);
  224.           Rewrite(fIco,1);
  225.  
  226.           BlockRead (fAni, pIco^, wIconSize);
  227.           BlockWrite(fIco, pIco^, wIconSize);
  228.  
  229.           Close (fIco);
  230.  
  231.           IF NOT Eof(fAni) THEN
  232.              BlockRead (fAni, pIco^, 8);
  233.  
  234.           Inc (wIco);
  235.  
  236.        END;
  237.  
  238.     Close (fAni);
  239.  
  240.     GotoXy (2, 15);
  241.     sTemp := sIcoName;
  242.     sIcoName := 'ANI_0000.CUR';
  243.     WriteLn ('');
  244.     WriteLn ('');
  245.     WriteLn ('File saved : '+sIcoName+' to '+sTemp+'.');
  246.     WriteLn ('');
  247.     WriteLn ('');
  248.     TextAttr := 7;
  249.  
  250. end;
  251.  
  252. Var
  253.    Ch : Char;
  254.  
  255. begin
  256.  
  257.      ClrScr;
  258.      TextAttr := 30;
  259.      WriteLn('');
  260.      WriteLn('┌──────────────────────────────────────────────────────────────────────┐');
  261.      WriteLn('│ Ani2Ico : Extraction utility from Christophe AVONTURE                │');
  262.      WriteLn('└──────────────────────────────────────────────────────────────────────┘');
  263.      WriteLn('');
  264.      WriteLn('');
  265.      TextAttr := 7;
  266.  
  267.      If Not (ParamCount = 1) then Begin
  268.         TextAttr := 14;
  269.         WriteLn('■ PURPOSE');
  270.         TextAttr := 11;
  271.         WriteLn('');
  272.         WriteLn('  Ani2Ico program  will allowed you to  extract all cursors pictures  from');
  273.         WriteLn('  an animated Windows 95 (c) cursor file.');
  274.         WriteLn('');
  275.         WriteLn('  This program will scan the enterly file and, each time  he encounters an');
  276.         WriteLn('  picture, he will saved it into the current directory.');
  277.         WriteLn('');
  278.         WriteLn('');
  279.         Ch := ReadKey; If Ch = #0 then Ch := ReadKey;
  280.         ClrScrWin (1,6,79,24);
  281.         GotoXy (1,6);
  282.         TextAttr := 14;
  283.         WriteLn('■ UTILISATION');
  284.         TextAttr := 11;
  285.         WriteLn('');
  286.         WriteLn('');
  287.         WriteLn('  Very easy!');
  288.         WriteLn('');
  289.         WriteLn('');
  290.         WriteLn('  Just type  the file name  of your  animated  cursor file  (with path  if');
  291.         WriteLn('  needed) as the first parameter.');
  292.         WriteLn('');
  293.         WriteLn('  For example, you can type "Ani2Ico.Exe Eyes.Ani".');
  294.         WriteLn('');
  295.         WriteLn('  You will receive several file name ANI_9999.ICO  or ANI_9999.CUR depends');
  296.         WriteLn('  on the size in bytes of the picture. 9999 is a numerical value from 0001');
  297.         WriteLn('  to the number of images in the animated cursor.');
  298.         WriteLn('');
  299.         Ch := ReadKey; If Ch = #0 then Ch := ReadKey;
  300.         ClrScrWin (1,6,79,24);
  301.         GotoXy (1,6);
  302.         TextAttr := 14;
  303.         WriteLn('■ IN THE FUTURE');
  304.         TextAttr := 11;
  305.         WriteLn('');
  306.         WriteLn('  Actually, I''m developping a Delphi component for  Delphi 1.0  and Delphi');
  307.         WriteLn('  2.0 component.  This component will allowed you to  increase the  design');
  308.         WriteLn('  of your applications by some animations.');
  309.         WriteLn('');
  310.         WriteLn('  This component is in developpement -I''ve just started-!');
  311.         WriteLn('');
  312.         WriteLn('  I think that I will distribute it as Shareware.  Wait and see...');
  313.         WriteLn('');
  314.         WriteLn('');
  315.         WriteLn('  People interested by this component should send me an email  and type in');
  316.         WriteLn('  the mail subject "Component TAVCAnimated wanted".');
  317.         WriteLn('');
  318.         WriteLn('');
  319.         GotoXy (0,6);
  320.         Ch := ReadKey; If Ch = #0 then Ch := ReadKey;
  321.         ClrScrWin (1,6,79,23);
  322.         GotoXy (1,6);
  323.         TextAttr := 14;
  324.         WriteLn('■ REGISTRATION');
  325.         TextAttr := 11;
  326.         WriteLn('');
  327.         WriteLn('  This program is free. ');
  328.         WriteLn('');
  329.         WriteLn('  No need to send me a lot of  US Dollar but you can if you want  (Hum, is');
  330.         WriteLn('  there somebody here?).');
  331.         WriteLn('');
  332.         WriteLn('  My only requirement is: IF YOU USE  THIS PROGRAM AND  IF THIS PROGRAM IS');
  333.         WriteLn('  USEFULL, PLEASE  SEND ME A POSTCARD (MY PREFERENCE) FROM  WHERE YOU LIVE');
  334.         WriteLn('  OR AN ELECTRONIC E-MAIL THROUGH INTERNET.  I WILL REALLY APPRECIATE.');
  335.         WriteLn('');
  336.         TextAttr := 10;
  337.         WriteLn('   AVONTURE Christophe');
  338.         WriteLn('   AVC Software');
  339.         WriteLn('   boulevard Edmond Machtens, 175 - Bte 53');
  340.         WriteLn('   B-1080 Bruxelles');
  341.         WriteLn('   BELGIQUE');
  342.         WriteLn('');
  343.         Ch := ReadKey; If Ch = #0 then Ch := ReadKey;
  344.  
  345.      End
  346.    ELSE
  347.       Process;
  348.  
  349. end.